home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 2003 August / MW 8 2003 CD1.iso / Inside Macworld / Product News / gimp-1.2.4.sit / gimp-1.2.4 / plug-ins / perl / examples / gouge < prev    next >
Encoding:
Text File  |  2000-05-16  |  3.3 KB  |  128 lines
  1. #!/usr/bin/perl
  2.  
  3. # implements some algorithms described in (the otherwise very bad)
  4. # http://www.biocomputer.com/Thesis.html
  5.  
  6. # these are all simple 2x2 kernels, fast but relatively effective
  7.  
  8. use Gimp::Feature 'pdl';
  9. use Gimp 1.098;
  10. use Gimp::Fu;
  11. use PDL::LiteF;
  12.  
  13. sub iterate {
  14.    my ($drawable,$message,$kernel)=@_;
  15.  
  16.    Gimp->progress_init ($message);
  17.  
  18.    my @bounds = $drawable->bounds;
  19.    my @off = $drawable->offsets;
  20.    $bounds[2]-- if $bounds[0]+$bounds[2] >= ($drawable->offsets)[0]+$drawable->width;
  21.    $bounds[3]-- if $bounds[1]+$bounds[3] >= ($drawable->offsets)[1]+$drawable->height;
  22.    {
  23.       my $src = new PixelRgn ($drawable,@bounds[0,1],$bounds[2]+1,$bounds[3]+1,0,0);
  24.       my $dst = new PixelRgn ($drawable,@bounds,1,1);
  25.  
  26.       my $iter = Gimp->pixel_rgns_register ($dst);
  27.       my $area = $bounds[2]*$bounds[3];
  28.       my $progress = 0;
  29.  
  30.       do {
  31.          my ($x,$y,$w,$h)=($dst->x,$dst->y,$dst->w,$dst->h);
  32.          $dst->data($kernel->($src->get_rect($x,$y,$w+1,$h+1)->convert(short)));
  33.          $progress += $w*$h/$area;
  34.          Gimp->progress_update ($progress);
  35.       } while (Gimp->pixel_rgns_process ($iter));
  36.    }
  37.    Gimp->progress_update (1);
  38.  
  39.    $drawable->merge_shadow (1);
  40.    $drawable->update (@bounds);
  41.  
  42.    ();
  43. }
  44.  
  45. register "blur_2x2",
  46.          "smooth (low pass filter) an image using a fast 2x2 kernel",
  47.          "Low-pass filtering (smoothing) using a fast 2x2 kernel",
  48.          "Marc Lehmann",
  49.          "Marc Lehmann <pcg\@goof.com>",
  50.          "19990725",
  51. #        N_"<Image>/Filters/Blur/2x2 Blur",
  52.          "<None>",
  53.          "RGB*, GRAY*",    
  54.          [],
  55.          sub {
  56.    my($image,$drawable)=@_;
  57.  
  58.    iterate $drawable,
  59.            "2x2 smoothing...",
  60.            sub {
  61.               ($_[0]->slice(":,0:-2,0:-2")+
  62.                $_[0]->slice(":,1:-1,0:-2")+
  63.                $_[0]->slice(":,1:-1,1:-1")+
  64.                $_[0]->slice(":,0:-2,1:-1"))>>2;
  65.            };
  66. };
  67.  
  68. register "contrast_enhance_2x2",
  69.          "contrast enhance an image using a fast 2x2 kernel",
  70.          "Contrast Enhance an image using a fast 2x2 kernel",
  71.          "Marc Lehmann",
  72.          "Marc Lehmann <pcg\@goof.com>",
  73.          "19990725",
  74.          N_"<Image>/Filters/Enhance/2x2 Contrast Enhance",
  75.          "RGB*, GRAY*",    
  76.          [],
  77.          sub {
  78.    my($image,$drawable)=@_;
  79.  
  80.    iterate $drawable,
  81.            "2x2 contrast enhancing...",
  82.            sub {
  83.               my $T = $_[0]->slice(":,0:-2,0:-2");
  84.               my $D = $_[0]->slice(":,1:-1,1:-1");
  85.  
  86.               (($T<<1)-$D)->clip(0,255);
  87.            };
  88. };
  89.  
  90. register "edge_detect_2x2",
  91.          "detects edges in an image using a fast 2x2 kernel",
  92.          "Detect edges in the image using a 2x2 kernel. It is similar to Sobel, yet sharper (and lower quality).",
  93.          "Marc Lehmann",
  94.          "Marc Lehmann <pcg\@goof.com>",
  95.          "19990725",
  96. #         N_"<Image>/Filters/Edge-Detect/2x2 Edge Detect",
  97.          "<None>",
  98.          "RGB*, GRAY*",    
  99.          [],
  100.          sub {
  101.    my($image,$drawable)=@_;
  102.  
  103.    iterate $drawable,
  104.            "2x2 cross gradient...",
  105.            sub {
  106.               my $T = $_[0]->slice(":,0:-2,0:-2");
  107.               my $R = $_[0]->slice(":,1:-1,0:-2");
  108.               my $D = $_[0]->slice(":,1:-1,1:-1");
  109.  
  110.               abs(cat($T-$R,$T-$D))
  111.               ->convert(byte)
  112.               ->mv(3,0)
  113.               ->maximum;
  114.            };
  115. };
  116.  
  117. exit main;
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.